#!/usr/bin/perl -w

use strict;

use Cwd qw/ abs_path /;
use Env qw/ PATH /;
use FindBin;
use lib "$FindBin::Bin";
use DCMARCH::Util qw/ Run isTarchive Meta /;
use File::Basename;
use File::Find;
use Getopt::Tabular;

$PATH = "${PATH}:$FindBin::Bin";

my $Execute = 1;
my $Debug   = 0;
my $Verbose = 0;
my $Quick   = 0;
my $UseFileName = 0;
my $QuickCheckFields = '-pid -pname -date -series -studyuid';
my $RefTarchive;
my $UseRef  = 0;

my $Me = fileparse($0);

my $Usage = <<USAGE;

Usage: $Me [options] <dir>|<tarchive> [<dir>|<tarchive> ...]

USAGE

my $Help = <<HELP;

Given a list of directories and/or tarchives, identifies all duplicate
tarchives in that directory and lists them, with each line of output
being a space-separated list of duplicate filenames. Any files that do
not have a .tar extension are ignored.

HELP

&Getopt::Tabular::SetHelp($Help, $Usage);

my @ArgTable = (
    ["General options", "section"],
    ["-verbose|-quiet", "boolean", 1, \$Verbose, "Be verbose"],
    ["-debug", "boolean", 1, \$Debug, "Be more verbose"],
    ["-execute", "boolean", 1, \$Execute, "Execute commands"],
    ["Specific options", "section"],
    ["-reference", "string", 1, \$RefTarchive,
     "Only report duplicates of the supplied reference tarchive (without including it)", "<tarchive>"],
    ["-quick|-slow", "boolean", 1, \$Quick, 
     "Check only these fields: patient name, patient ID, scan date, series numbers, study uid. This is NOT a fool-proof check, but it does circumvent missing 'identical' tarchives only differing in the DICOM InstanceCreationTime field"],
    ["-use_filename|-ignore_filename", "boolean", 1, \$UseFileName, 
     "Assume the tarchive file name contains the scan date in yyyy-mm-dd and use that to pre-select candidate duplicates. This is fast, but only used together with -ref"],
    );

my @Args;
&GetOptions(\@ArgTable, \@ARGV, \@Args) || exit 1;

die $Usage if !@Args;

$DCMARCH::Util::Debug   = $Debug;
$DCMARCH::Util::Verbose = $Verbose;
$DCMARCH::Util::Execute = $Execute;

die "There is no point in specifying -use_filename without -ref\n"
    if ($UseFileName && ! defined $RefTarchive);

# The hash that will keep the duplicates lists
my %Tarchives;

my $RefDate;
my $RefKey;
if (defined $RefTarchive) {
    $UseRef = 1;

    die "$RefTarchive is not a dicom-archive\n$Usage\n" 
	if (!&isTarchive($RefTarchive));

    if ($RefTarchive =~ /DCM_(\d{4}-\d{2}-\d{2})_/) {
	$RefDate = $1;
    }
    else {
	$RefDate = `tarchiveInfo.pl -date $RefTarchive`;
	chomp $RefDate;
	$RefDate =~ s/^(\d\d\d\d)(\d\d)(\d\d)$/$1-$2-$3/;
    }

    print "Reference scan date: $RefDate\n" if $Verbose;

    $RefKey = &HashKey($RefTarchive);

    $RefTarchive = abs_path($RefTarchive);

    ${Tarchives}{$RefKey} = [ $RefTarchive ];
}

# Process all supplied arguments
foreach my $arg (@Args) {
    if (-d $arg) {
	find(\&TarchiveFinder, $arg);
    }
    else {
	&TarchiveSelector($arg);
    }
}

# If we are using a reference tarchive, we only need to list it's
# duplicates (without the reference itself)

my @Keys = ($UseRef) ? ($RefKey) : keys %Tarchives;

foreach my $key (@Keys) {
    if (@{ $Tarchives{$key} } > 1) {
	shift @{ $Tarchives{$key} } if $UseRef;
	print join(' ', @{ $Tarchives{$key} }) . "\n";
    }
}
    

#==========================================================
# Subroutines
#==========================================================

sub TarchiveSelector {
    my $file = shift;
    
    # We do expect a file, and one that ends in .tar
    return if (! -f $file || ($file !~ /\.tar$/));
    
    # If we are using a reference tarchive we don't need to store it
    # again
    return if ($UseRef && (abs_path($file) eq $RefTarchive));
    
    # If we are using a reference tarchive and relying on dates in
    # file names, no need to bother with tarchives that do not match
    # that date
    return if ($UseFileName && $UseRef && $file !~ /$RefDate/);
    
    # Finally, this better be a tarchive
    return if (!&isTarchive($file));
    
    print "Adding file $file\n" if $Debug;
    
    my $key = &HashKey($file);
    
    if (defined $Tarchives{$key}) {
	push(@{ $Tarchives{$key} }, $file);
    }
    else {
	$Tarchives{$key} = [ $file ];
    }
}

sub TarchiveFinder {
    &TarchiveSelector($File::Find::name);
}

sub HashKey {
    my $tarchive = shift;
    
    my $infoopt = ($Quick) ? $QuickCheckFields : '-meta';

    return `tarchiveInfo.pl $infoopt $tarchive`;
}
